home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / prolot14.arc / PROLOT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-06-02  |  7KB  |  242 lines
  1.  
  2. (*
  3.  * ProLOT.PAS - Lottery Door for the ProKit system
  4.  *
  5.  * (C) 1988 Samuel H, Smith (02-Feb-88)
  6.  *
  7.  *)
  8.  
  9. {$M 12000,40000,40000}  {Stack, minheap, maxheap}
  10. {$L-}                   {Don't link in ram}
  11. {$T+}                   {Make mapfile}
  12.  
  13. Program Lottery;
  14.  
  15. {$i prokit.inc}    {include standard 'uses' statement}
  16.  
  17. const
  18.    version = '(ProLot v1.4, 05-21-88)';
  19.  
  20. var
  21.    fd:       text;
  22.    driver:   string;   {driver type; taken care of automatically}
  23.    bltname:  string;   {winner bulletin filename}
  24.    pot:      real;     {how many minutes in the jackpot}
  25.    plays:    real;     {how many tickets have been sold}
  26.    house:    real;     {fraction of time payed to deduct for the house}
  27.    odds:     real;     {odds against each ticket winning}
  28.    winner:   string;   {last winner information}
  29.    histname: string;   {winner history file}
  30.    rigged:   boolean;  {is the game rigged to lose?  (set after a win)}
  31.  
  32.  
  33.  
  34. (* ---------------------------------------------------------------- *)
  35. procedure load_info;
  36.    {load the latest information about the lottery game}
  37. begin
  38.    assignText(fd,config_file);
  39.    filemode := $42;  {deny none share mode}
  40.    reset(fd);
  41.    readln(fd,driver);
  42.    readln(fd,bltname);
  43.    readln(fd,pot);
  44.    readln(fd,plays);
  45.    readln(fd,house);
  46.    readln(fd,odds);
  47.    readln(fd,winner);
  48.    readln(fd,histname);
  49.    if histname = '' then
  50.       histname := 'nul';
  51.    close(fd);
  52. end;
  53.  
  54.  
  55. (* ---------------------------------------------------------------- *)
  56. procedure save_info;
  57.    {save the latest information about the lottery game}
  58. begin
  59.    assignText(fd,config_file);
  60.    filemode := $42;  {deny none share mode}
  61.    rewrite(fd);
  62.    writeln(fd,driver);
  63.    writeln(fd,bltname);
  64.    writeln(fd,pot:0:1);
  65.    writeln(fd,plays:0:0);
  66.    writeln(fd,house:0:2);
  67.    writeln(fd,odds:0:0);
  68.    writeln(fd,winner);
  69.    writeln(fd,histname);
  70.    writeln(fd);
  71.    writeln(fd,'--------------------------');
  72.    writeln(fd,'Configuration file format:');
  73.    writeln(fd);
  74.    writeln(fd,'line 1 = Driver type (HANDSHAKE, INTERRUPT, BIOS, PCBTRAP)');
  75.    writeln(fd,'line 2 = Lottery status bulletin filename');
  76.    writeln(fd,'line 3 = Number of minutes currently in the pot');
  77.    writeln(fd,'line 4 = Number of tickets sold so far');
  78.    writeln(fd,'line 5 = Fraction of time taken aside for sysop');
  79.    writeln(fd,'line 6 = Odds against winning (higher numbers give higher jackpots)');
  80.    writeln(fd,'line 7 = Information about the last winner');
  81.    writeln(fd,'line 8 = Lottery winner history bulletin filename');
  82.    close(fd);
  83. end;
  84.  
  85.  
  86. (* ---------------------------------------------------------------- *)
  87. procedure process_bet(num: integer);
  88. var
  89.    payoff:      real;
  90.    roll:        real;
  91.    i:           integer;
  92.    ready:       real;
  93.  
  94. begin
  95.    if dump_user then exit;
  96.    disp(GREEN+'Ticket # '+ftoa(num,2,0)+': ');
  97.  
  98.    plays := plays + 1.0;
  99.    pot := pot + 1.0-house;    {add to pot, but keep some for the house}
  100.    adjust_time_allowed(-60);  {charge 1 minute}
  101.  
  102.    flush_com;
  103.    ready := get_time + 0.5;
  104.    repeat
  105.       roll := int((random-0.5)*odds);
  106.    until get_time >= ready;
  107.  
  108.    if (roll = 0) and not rigged then
  109.    begin
  110.       rigged := true;  {only allow 1 win per session}
  111.       payoff := int(pot * (1.0-house));
  112.  
  113.       (* prevent withdrawals before an upcoming event *)
  114.       if (pcbsetup.slide_event = false) and event_run_needed(event_possible) then
  115.          displn('You MUST be off the system by '+pcbsetup.event_time+' due to a scheduled event.');
  116.       
  117.       adjust_time_allowed(payoff*60);
  118.       pot := pot - payoff;
  119.  
  120.       disp(^G^G);
  121.       displn(RED+'Is a winner!  You win '+ftoa(payoff,0,0)+' minutes!');
  122.  
  123.       winner := 'The last winner was '+username+', who won '+ftoa(payoff,0,0)+
  124.                 ' minutes on '+system_date + ' ' + system_time + '.';
  125.  
  126.       make_log_entry('Lottery winner!  Granted '+ftoa(payoff,0,0)+' minutes.',false);
  127.  
  128.       assignText(fd,histname);
  129.       if exists(histname) then
  130.          append(fd)
  131.       else
  132.       begin
  133.          filemode := $42;  {deny none share mode}
  134.          rewrite(fd);
  135.          writeln(fd);
  136.          writeln(fd,'Lottery winners since '+system_date+'.');
  137.          writeln(fd);
  138.       end;
  139.  
  140.       writeln(fd,username,' won '+ftoa(payoff,0,0)+
  141.                  ' minutes on '+system_date+' '+system_time+'.');
  142.       close(fd);
  143.    end
  144.    else
  145.       displn(BLUE+'is a loser.');
  146.  
  147. end;
  148.  
  149.  
  150. (* ---------------------------------------------------------------- *)
  151. procedure play;
  152.    {main play procedure}
  153. var
  154.    i:   integer;
  155.    buy: integer;
  156.  
  157. begin
  158.    rigged := false;
  159.  
  160.    displn(WHITE);
  161.    displn('Welcome to the ProKit lottery!   '+version);
  162.    displn(RED);
  163.    displn('The odds are '+ftoa(odds,0,0)+':1.  Sysop keeps '+ftoa(house*100,0,0)+'% of the take.');
  164.    displn(GREEN);
  165.    displn(winner);
  166.  
  167.    displn(YELLOW);
  168.    disp('Do you want to see a list of lottery winners: (Enter)=yes? ');
  169.    get_cmdline;
  170.    if cmdline[1] <> 'N' then
  171.       display_file(histname);
  172.  
  173.    repeat
  174.       displn(WHITE);
  175.       displn('A total of '+ftoa(plays,0,0)+' tickets have been sold.');
  176.       displn('The jackpot now contains '+ftoa(pot,0,0)+' minutes.');
  177.       displn('Tickets cost 1 minute each.');
  178.       newline;
  179.  
  180.       display_time_left;
  181.       disp(YELLOW+'How many would you like to buy: (0 to quit)? ');
  182.       get_cmdline;              {get cmdline, map to upper case}
  183.       newline;
  184.  
  185.       buy := atoi(cmdline);
  186.       if buy > minutes_left then
  187.          displn('You don''t have that much time!')
  188.       else
  189.  
  190.       for i := 1 to buy do
  191.          process_bet(i);
  192.  
  193.    until dump_user or (cmdline = '0') or (minutes_left < 2);
  194.  
  195.    if not dump_user and (minutes_left < 2) then
  196.    begin
  197.       dump_user := true;
  198.       option := o_logoff;
  199.    end;
  200.    
  201.    newline;
  202.    displn('Thanks for playing the ProKit lottery!  Come back soon...');
  203. end;
  204.  
  205.  
  206. (* ---------------------------------------------------------------- *)
  207. procedure generate_blt;
  208.    {generate a lottery status bulletin}
  209. begin
  210.    assignText(fd,bltname);
  211.    rewrite(fd);
  212.    writeln(fd);
  213.    writeln(fd,'ProKit Lottery Statistics!   '+version);
  214.    writeln(fd);
  215.    writeln(fd,winner);
  216.    writeln(fd,'The odds are '+ftoa(odds,0,0)+':1.  Sysop keeps '+ftoa(house*100,0,0)+'% of the take.');
  217.    writeln(fd,'A total of '+ftoa(plays,0,0)+' tickets have been sold.');
  218.    writeln(fd,'The jackpot now contains '+ftoa(pot,0,0)+' minutes.');
  219.    writeln(fd);
  220.    close(fd);
  221. end;
  222.  
  223.  
  224. (* ---------------------------------------------------------------- *)
  225.  
  226. begin  {main block}
  227.    init;     {must be first - opens com port, loads setup and user data}
  228.  
  229.    load_color_constants('PROCOLOR');
  230.                             {use 'PROCOLOR' to redefine colors; defaults used
  231.                              if this file is missing}
  232.  
  233.    progname := 'Lottery';   {program name on status line}
  234.    load_info;               {load info from config file}
  235.    play;                    {insert your code here}
  236.    save_info;               {save latest info}
  237.    generate_blt;            {generate a lottery status bulletin}
  238.  
  239.    uninit;   {must be last - closes com port and updates database}
  240. end.
  241.  
  242.